home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / u137.src < prev    next >
Text File  |  1990-10-20  |  3KB  |  123 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ by Mattias Dahl & Morgan Lindqvist
  3. DIR 
  4.   U137
  5.     \<< 2 - 7 MOD 2 + DUP INIT (5,5) \-> ANT POS AIM
  6.        \<< 0 POS AIM ANT WFACT 'POS' STO DROP AIM GMARK
  7.           DO 1 + POS AIM GETK DUP 'AIM' STO ANT WFACT 'POS' STO OBJ\->
  8.           UNTIL 1 SWAP 1 -
  9.             START + 
  10.             NEXT 0 SAME
  11.           END MOVES \->TAG
  12.         \>>
  13.       \>>
  14.  
  15.   GETK
  16.     \<<
  17.       DO
  18.         DO KEY
  19.         UNTIL
  20.         END
  21.       UNTIL
  22.         CASE DUP 25 SAME
  23.         THEN 24 - GMOVE 0
  24.         END DUP DUP DUP 34 SAME SWAP 35 SAME OR SWAP 36 SAME OR
  25.         THEN 32 - GMOVE 0
  26.         END 51 SAME
  27.         THEN 1
  28.         END 0
  29.         END
  30.       END
  31.     \>>
  32.  
  33.   GMOVE
  34.     \<< \-> P V
  35.       \<< P C\->R
  36.         CASE V 1 SAME
  37.           THEN
  38.             IF DUP 1 SAME NOT
  39.             THEN 1 -
  40.             END
  41.           END V 2 SAME
  42.           THEN SWAP
  43.             IF DUP 1 SAME NOT
  44.             THEN 1 -
  45.             END SWAP
  46.           END V 3 SAME
  47.           THEN
  48.             IF DUP 10 SAME NOT
  49.             THEN 1 +
  50.             END
  51.           END SWAP
  52.           IF DUP 10 SAME NOT
  53.           THEN 1 +
  54.           END SWAP
  55.         END R\->C DUP 'V' STO GMARK P GMARK 
  56.         PICT { # 107d # 0d } V \->STR " " + 1 \->GROB REPL V
  57.       \>>
  58.     \>>
  59.  
  60.   GMARK
  61.     \<< C\->R 1 - 6 * 1 + R\->B SWAP 1 - 6 * 2 + R\->B SWAP
  62.       2 \->LIST PICT SWAP "*" 1 \->GROB GXOR
  63.     \>>
  64.  
  65.   INIT
  66.     \<< \-> A
  67.       \<< PICT { # 0d # 0d } # 131d # 64d BLANK REPL { # 0d# 0d } PVIEW 0 10
  68.         FOR X
  69.           # 0d X 6 * R\->B 2 \->LIST DUP 1 # 60d PUT LINE
  70.           6 X * R\->B # 0d 2 \->LIST DUP 2 # 60d PUT LINE
  71.         NEXT
  72.         PICT { # 67d # 0d } "Aiming at (5,5)" 1 \->GROB REPL
  73.         PICT { # 67d # 6d } "MOVES" 1 \->GROB REPL 1 A
  74.         FOR X
  75.           PICT # 67d X 1 + 6 * R\->B 2 \->LIST "SUB :" X + 1 \->GROB REPL
  76.           RAND 10 * IP 1 + RAND 10 * IP 1 + R\->C
  77.         NEXT A \->LIST
  78.       \>>
  79.     \>>
  80.  
  81.   WFACT
  82.     \<< 0 \-> POS AIM ANT DIS
  83.       \<< POS ANT AIM MSUB 'POS' STO 'DIS' STO 1 ANT
  84.         FOR X PICT # 104d X 1 + 6 * R\->B 2 \->LIST 'DIS' X GET
  85.           IF DUP 0 SAME
  86.           THEN DROP "SUNKEN"
  87.           ELSE \->STR
  88.           END 1 \->GROB REPL
  89.         NEXT PICT {# 104d # 6d } 3 PICK \->STR 1 \->GROB REPL DIS POS
  90.       \>>
  91.     \>>
  92.  
  93.   MSUB
  94.     \<< \-> POS ANT AIM
  95.       \<< 1 ANT
  96.         FOR X 'POS' X GET
  97.           IF DUP 0 SAME NOT
  98.           THEN AIM - C\->R ABS SWAP ABS MAX
  99.             IF DUP 0 SAME
  100.             THEN 'POS' X 0 PUT
  101.             ELSE
  102.               IF 59 FS?
  103.               THEN 'POS' X GET DUP GMARK GMARK
  104.               END
  105.               IF 60 FS?
  106.               THEN 'POS' DUP X GET C\->R 1 2
  107.                 START RAND 3 * IP 1 - + 
  108.                   IF DUP 10 >
  109.                   THEN 1 -
  110.                   END
  111.                   IF DUP 1 <
  112.                   THEN 1 +
  113.                   END SWAP
  114.                 NEXT R\->C X SWAP PUT
  115.               END
  116.             END
  117.           END
  118.         NEXT ANT \->LIST POS
  119.       \>>
  120.     \>>
  121.  
  122. END
  123.